Demand

Row

Elapsed quarters

2

Total Days in selected quarters

181

Selected Warehouse

Ravenna

Revenue

€4,288,106

Consolidated Consumption Value (CCV)

€2,255,236

Margin

€2,032,870

Row

Demand Map

Demand

Product Segmentation

column

ABC-XYZ Segmentation

Additional info

column

ABC Segmentation

XYZ Segmentation

Forecast

Row

Model forecast for the next 10 days

1

Forecast is valid from this date

2023-07-04

Forecast validity ends here

2023-07-14

Days in the test set

10

Root Mean Squared Errors of best model (RMSE)

0.39

Forecast ensamble cosine similarity

1

Row

Demand

Forecast Error

Decomposition

Row

Is this a random walk?

FALSE

Is this white noise?

TRUE

Is this autocorrelated?

FALSE

Seasonality strength (0-1)

0.22

Trend strength (0-1)

0.23

Zero sales proportion (0-1)

0.88

Row

STL Decomposition

Autocorrelation Function

Forecast Dashboard

column

Forecast error proportion

Additional info

column

Error Distribution

Impact on sales

---
title: "Demand Forecasting"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
---

```{r setup, include=FALSE}

```

```{r libraries, include=FALSE}
library(flexdashboard)
library(odbc)
library(DBI)
library(RSQLite)
library(tidyverse)
library(tictoc)
library(lubridate)
library(assertthat)
library(plotly)
library(leaflet)
library(geosphere)
library(highcharter)
library(TTR)
library(downloadthis)
library(fpp3)
library(lsa)
```

```{r parameters}
db_path = file.path("..", "..", "data", "m0", "raw", "raw_sca.db")
deliverable_db_path = file.path("..", "..","data", "results", "del_sca.db")
geo_codes_path = file.path("..","..","data","m0","raw","geonames-all-cities-with-a-population-1000.csv")
```

```{r udf}
euro <- scales::dollar_format(prefix="\u20ac",suffix = "")
```

```{r DB connections}
raw_con <- dbConnect(RSQLite::SQLite(), db_path)
del_con <- dbConnect(RSQLite::SQLite(), deliverable_db_path)
```

```{r save tables}
#dbListTables(conn = del_con)
del_tbl = tbl(src = del_con, "currentProductSegmentation")
raw_tbl = tbl(src = raw_con, "salesUpdated")

# Coords
# retrieved from https://public.opendatasoft.com/explore/dataset/geonames-all-cities-with-a-population-1000/map/?disjunctive.cou_name_en&sort=name&refine.timezone=Europe%2FRome&location=6,44.48328,9.76685&basemap=jawg.light
geocode = read.csv(geo_codes_path, sep = ";")
```

```{r store datasets}
past_quarters = del_tbl %>% collect()
sales_updated = raw_tbl %>% collect()
```

# Demand {data-orientation="rows" data-navmenu="M1"}

## Row

### Elapsed quarters

```{r}
last_update = sales_updated %>% 
  pull(SalesDate) %>% 
  unique() %>% 
  as_date() %>% 
  max()

current_date = Sys.Date() - days(Sys.Date() - last_update)
year_start   = as_date(paste0(year(current_date), "-01-01"))
time = data.frame(SalesDate = seq(year_start,
                                  current_date,
                                  by = "day")) %>% 
  mutate(quarters           = quarter(SalesDate),
         is_current_quarter = quarter(SalesDate) == quarter(Sys.Date())) 

elapsed_quarters = time %>% 
  filter(is_current_quarter == F) %>% 
  pull(quarters) %>% 
  unique() %>% 
  length()

valueBox(value     = elapsed_quarters,
         icon      = "fa-calendar-days",
         col       = "primary")
```

### Total Days in selected quarters

```{r}
time_span = time %>% 
  filter(is_current_quarter == F) %>% 
  nrow()

valueBox(value     = time_span,
         icon      = "fa-calendar-day",
         col       = "primary")
```

### Selected Warehouse

```{r}
current_warehouse = sales_updated %>% 
  pull(Warehouse) %>% 
  unique() %>% 
  word(start = 2, sep = " ")

valueBox(value     = current_warehouse,
         icon      = "fa-warehouse",
         col       = "warning")
```

### Revenue

```{r}
# Here we didn't remove the cancelled orders so this quantity is inflated
# We need to correct it in the next iteration
revenue = del_tbl %>%
  pull(Revenue) %>% 
  sum()

valueBox(value = euro(revenue),
         icon  = "fa-briefcase",
         col  = "success")
```

### Consolidated Consumption Value (CCV)

```{r}
acv = past_quarters %>% pull(cost) %>% sum()
flexdashboard::valueBox(value  = euro(acv),
                        icon = "fa-briefcase",
                        col="danger")

dbDisconnect(conn = del_con)
dbDisconnect(conn = raw_con)
```

### Margin

```{r}
# Revenue has the cancelled orders inside so this is correct
# Correcting Revenue will solve this problem
nr = past_quarters %>% pull(Net_Revenue) %>% sum()
flexdashboard::valueBox(value  = euro(nr),
                        icon   = "fa-sack-dollar",
                        col    = "success")
```

## Row

### Demand Map

```{r}
# Filter the coords dataset to keep only stores referring to the current warehouse
stores  = sales_updated$Store %>% unique()
geocode = geocode %>% 
  filter(toupper(Name) %in% stores) %>% 
  mutate(status = ifelse(current_warehouse == Name,
                         "Warehouse",
                         "Store"),
         radius = ifelse(status == "Warehouse", 12, 6)) %>% 
  separate(Coordinates, into = c("coord_a", "coord_b"), sep = ",", convert = T, 
           remove = F) %>% 
  rename(city = Name)

# ATM we're displaying population,
# but in future we should display the number of orders by store
# the same for popup. Now it shows the name of the city
# but we can do somethin else
geocode %>%
  leaflet() %>%
  addTiles() %>% 
  setView(lng = 11.3426, 
          lat = 44.4949,
          zoom = 5) %>% 
  addCircles(lng    = ~ coord_b,
             lat    = ~ coord_a,
             weight = 1,
             radius = ~ sqrt(Population) * 30,
             color  = ~ ifelse(status == "Warehouse", "red", "blue"),
             popup  = ~ city,
             group  = ~ status) %>% 
  addLayersControl(overlayGroups = ~ status,
                   options = layersControlOptions(collapsed = F))

```

### Demand

```{r}
# ATM we are not checking if there are missing dates
# I think that is good actually, because that would a closed store
orders_data = sales_updated %>% 
  dplyr::select(SalesDate, UnitsSold) %>% 
  group_by(SalesDate) %>% 
  summarise(n = sum(UnitsSold)) %>% 
  mutate(SMA = SMA(n),
         EMA = EMA(n),
         SalesDate = as_date(SalesDate),
         RSI = RSI(n),
         RSI_sell= 70,
         RSI_buy=30)

# Computing complex metrics like bollinger bands and macd
bb         = BBands(orders_data$n) %>% as_tibble()
names(bb)  = paste("bb", names(bb), sep = "_")
macd       = MACD(orders_data$n) %>% as_tibble() %>% rename(macd_signal = signal)

# Aggregating data in a dataframe
orders_data = bind_cols(orders_data, bb, macd)
rm(bb, macd)

# Plot it
chart = highchart(type = "stock") %>% 
  hc_yAxis_multiples(create_yaxis(3, heigth = c(2,1,1), turnopposite = T)) %>% 
  hc_add_series(orders_data, yAxis = 0, "line", hcaes(x=SalesDate, y = n), name = "Demand") %>% 
  hc_add_series(orders_data, yAxis = 0, "line", hcaes(x=SalesDate, y = EMA), name = "EMA", color = "#FF0000") %>% 
  hc_add_series(orders_data,yAxis = 0, "arearange", hcaes(x    = SalesDate,
                                                low  = bb_dn,
                                                high = bb_up),
                name = "Bollinger Bands", color = "#2DFF00", fillOpacity = 0.1,
                lineWidth = 0.5) %>% 
  hc_add_series(orders_data, "line", yAxis = 1, hcaes(x=SalesDate, y=macd), name = "MACD", color="orange") %>% 
  hc_add_series(orders_data, "line", yAxis = 1, hcaes(x=SalesDate, y=macd_signal), name = "Signal", color="purple") %>% 
  hc_add_series(orders_data, "line", yAxis = 2, hcaes(x=SalesDate, y=RSI), name = "RSI", color = "dodgerblue") %>% 
  hc_add_series(orders_data, "line", yAxis = 2, hcaes(x=SalesDate, y=RSI_sell), name = "Sell", color = "red") %>% 
  hc_add_series(orders_data, "line", yAxis = 2, hcaes(x=SalesDate, y=RSI_buy), name = "Buy", color = "yellow") %>% 
  # hc_yAxis(title = list("Units sold"),
  #          opposite = FALSE) %>%
  hc_rangeSelector(selected = 5, selected = 2) %>% 
  hc_tooltip(valueDecimals = 2, split = TRUE) %>% 
  hc_navigator(enabled = T) %>% 
  hc_scrollbar(enabled = T)

chart
```

# Product Segmentation {data-orientation="columns" data-navmenu="M1"}

## column

### ABC-XYZ Segmentation

```{r}
past_quarters %>%
  mutate(abc_xyz = paste(multi_class_descriptor, 
                         xyz_class_descriptor,
                         sep = "-")) %>% 
  xtabs(~ abc_xyz, data = .) %>% 
  as_tibble() %>% 
  plot_ly(data = .) %>% 
  add_pie(labels = ~ abc_xyz, values = ~ n, hole = 0.5)
```

### Additional info {data-height="30"}

```{r}
## Download button for the emotional people
# src: https://fmmattioni.github.io/downloadthis/reference/download_this.html
past_quarters %>%
  relocate(Category, Supplier, Series, Article, .after = SKU) %>% 
  download_this(output_name      = "Product segmentation",
                output_extension = ".xlsx")
```

## column

### ABC Segmentation

```{r}
past_quarters %>%
  xtabs(~ multi_class_descriptor, data = .) %>% 
  as_tibble() %>% 
  plot_ly(data = .) %>% 
  add_pie(labels = ~ multi_class_descriptor, values = ~ n, hole = 0.5)
```

### XYZ Segmentation

```{r}
past_quarters %>%
  xtabs(~ xyz_class_descriptor, data = .) %>% 
  as_tibble() %>% 
  plot_ly(data   = ., 
          marker = list(colors = c("orange", "firebrick", "#118a0c")
                                   )) %>% 
  add_pie(labels = ~ xyz_class_descriptor, values = ~ n, hole = 0.5)
```

# Forecast {data-orientation="rows" data-navmenu="M2"}

## Row

### Model forecast for the next 10 days

```{r}
load("demo.rdata")
valueBox(value     = best_model_forecast,
         icon      = "fa-box",
         col       = "success")
```

### Forecast is valid from this date

```{r}
valueBox(value     = last_update,
         icon      = "fa-calendar-day",
         col       = "success")
```

### Forecast validity ends here

```{r}
valueBox(value     = last_update + days(10),
         icon      = "fa-calendar-day",
         col       = "warning")
```

### Days in the test set

```{r}
valueBox(value     = 10,
         icon      = "fa-calendar-days",
         col       = "primary")
```

### Root Mean Squared Errors of best model (RMSE)

```{r}
rms = model_evaluation %>% 
  filter(best_model == T) %>% 
  pull(RMSE)
valueBox(value     = round(rms,2),
         icon      = "fa-xmark",
         col       = "danger")
```

### Forecast ensamble cosine similarity

```{r}
# We use average cosine similarity as a measure of concordance
# between the forecast of different models

# Define your five values as a numeric vector
values <- model_evaluation$test_sales_forecast_horizon

# Create a matrix with all pairwise combinations of values
mat <- combn(values, 2)

# Calculate cosine similarity
cosine_sim <- lsa::cosine(mat)

# Find the maximum similarity score for cosine similarity
max_cosine_sim <- max(cosine_sim)
avg_cosine_sim <- mean(cosine_sim)

valueBox(value     = round(avg_cosine_sim,2),
         icon      = "fa-thumbs-up",
         col       = "success")
```

## Row

### Demand 

```{r}
load("demo.rdata")
chart
```

### Forecast Error

```{r}
fe
```

# Decomposition {data-orientation="rows" data-navmenu="M2"}

## Row

### Is this a random walk?

```{r}
load("demo stl.rdata")
if (description$is_random_walk) {
  valueBox(value = "TRUE",
           icon  = "fa-thumbs-down",
           col   = "danger") 
} else {
  valueBox(value = "FALSE",
           icon  = "fa-thumbs-up",
           col   = "success") 
}
```

### Is this white noise?

```{r}
load("demo stl.rdata")
if (description$is_white_noise) {
  valueBox(value = "TRUE",
           icon  = "fa-thumbs-down",
           col   = "danger") 
} else {
  valueBox(value = "FALSE",
           icon  = "fa-thumbs-up",
           col   = "success") 
}
```

### Is this autocorrelated?

```{r}
if (description$is_autocorrelated != "not autocorrelated") {
  valueBox(value = "TRUE",
           icon  = "fa-thumbs-up",
           col   = "success") 
} else {
  valueBox(value = "FALSE",
           icon  = "fa-thumbs-down",
           col   = "warning") 
}
```

### Seasonality strength (0-1)

```{r}
valueBox(value = round(description$seasonal_strength_week, 2),
         icon  = "fa-arrow-trend-up",
         col   = "primary")
```

### Trend strength (0-1)

```{r}
valueBox(value = round(description$trend_strength, 2),
         icon  = "fa-arrow-trend-up",
         col   = "primary")
```

### Zero sales proportion (0-1)

```{r}
valueBox(value = round(description$zero_sales_proportion, 2),
         icon  = "fa-empty-set",
         col   = "danger")
```
## Row

### STL Decomposition

```{r}
stl_plot
```

### Autocorrelation Function

```{r}
acf_plot
```

# Forecast Dashboard {data-orientation="columns" data-navmenu="M2"}

## column

### Forecast error proportion

```{r}
load("demo_overallmodels.rdata")

plot_a
```

### Additional info {data-height="30"}

```{r}
## Download button for the emotional people
# src: https://fmmattioni.github.io/downloadthis/reference/download_this.html
toplot %>%  
  download_this(output_name      = "Product segmentation",
                output_extension = ".xlsx")
```

## column

### Error Distribution

```{r}
plot_b
```

### Impact on sales

```{r}
plot_c
```